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FORSSEXIT_HANDL FORTRAN exit handler 6-Se AX-11 Bliss-32 V4.0-74 P 
e-3ep-1986 49:87:58 EPORRTL SRE SFOREXITHA.B32;1 m0 4} 
MODULE FORSSEXIT_HANDL (42TITL , FORTRAN exit handler’ 
TDENT = ‘1-01 ! File: FOREXITHA.B32 Edit: STAN1013 


BEGIN 


REAR ERA EERE AERA EERE RRA REREEAE AEE EAE AAT AAAAHEEEEREH EERE 


ie COPYRIGHT (c) 1978, 1980, 1982, 1984 B 
ie DIGITAL EQUIPMENT CORPORATION, MAYNARD. MASSACKUSETTS. 
it ALL RIGHTS RESERVED. 


1® ae tn Sethe fs FURNISHED UNDER A LICENSE AND MAY BE USED AND gh ta 

'® ONL E THE TERMS OF SU LICENSE AND WITH THE 

He INCLUSION OF THe ABOVE COPYRIGHT NOTICE. hd NY 
F 


ie OTHER PERSON. NO TITLE TO AND OWNERSHIP O 
'® TRANSFERRED. 


:* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
; aeePOkaT be NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 


is DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
!® SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


MIMIMINININ SS SS SOOOOOOOOCO 
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144 
! FACILITY: FORTRAN support Library - Exit handler 

i ABSTRACT: 

This module is used when the image exits to do 
FORTRAN post presesesne It purges 1/0 buffers 

and closes files with proper disposition. 

i ENVIRONMENT: User access mode; mixture of AST Level or not. 
i Author: John Sauter, Creation date: 23-JAN-1979 

i MODIFIED BY: 


' 
' 
' 
' 
! 
' 
' 
' 
' 
' 
' 
' 
' 
' 
' 
Ori inal from Sete ee Sopher Hb 
' 
' 
' 
! 
‘ 
' 
' 
' 
' 
' 
' 
' 


- 0B lus ony “dirt oa uffer. JBS 24-JAN-1979 
= Move call to OTSSSPURGE lowe” to rsse40 E Fi ILE. JBS 24-JAN-1979 
- Change Linkage for OTSSPUSH HACCE to JSB CB SPUSH” an onl for | 
“ee — S CCB to {38 ;°8. POP.” JBS 25-JAN-19 
005 - ollar s 1 for eat sheten. JBS 26-JAN-1979 
8 - Add gve,dol ier AL JBS 04-JUN-1979 
07 = Change to FORTRAN-s ecific me “handler. JBS [ecnue tere 
008 - c1per FORSSL_XIT_LOCK when EXIT. HANDLER is cated. 
: a lows exit weed Ter 1/0 to be c Seanad up properly. saat * 39-Apr-1980 
! 1-009 - pesvest BR ge alignment for the OWN PSECT when invoking 

ECLARE_PSECTS, to ensure that EXIT zPLOCk K will not occupy the 
aaa page as a user yor ieee that is be i, WATCHed, hus 
be unwriteable when $DCLEXH is called. JAW 19-FEB-1981 
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rgggeAT vor Fontan exit handle ens maakanmene, rae as 
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om 
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é 1! 1-010 - peciare LIBSSTOP of sercet SBL 30-Nov-1981 
1 ! 1-011 = Reflect changes str ryctures to FORS$. SBL 26-Oct-1982 
60 1 ! 1-012 = Reflect use of 1SBSA PREVIOU nstead of second longword in 
Sa FORSSAA_CUR_LUB. SBC 2=-Dec 

B26 | 1-013 = Remove tatofaational error. “STAN 24-Jul-1984. 

064 1 
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FORSSEXIT_HANDL FORTRAN exit handler 16-Sep-1984 00:22: AX-11 Bliss-32 V4.0-74 P 3 
1-013 10738b- 1382 99:99:98 PORRTL SRE SFOREXI INA. B92; 1 st ) 


> ei 065 1! 
; § 066 | { PROLOGUE FILE: 

; 668 067 1! 

; 34 0068 1 

; oy 9 2 } REQUIRE ‘RTLIN:FORPROLOG'; ! FORS definitions 

: i 1 $ 1! 

3 7 1 1 ! TABLE OF CONTENTS: 

; 6 og6 0138 1! 

es 0139 1 

; 76 0140 1 FORWARD ROUTINE 

Be 4 0141 1 FORSSDECL_EXITH : NOVALUE, ! Declare EXIT handler 

; o1eg 1 EXIT HANDCER : NOVALUE, ' Exit Handler 

; 7 0143 1 FORSSCLOSE_ALL : NOVALUE; ! Close all files 

; 0144 1 

— i 0145 1! 

; 8 0146 1 ! MACROS: 

.-¢ 0147 1! 

; & 0148 1! NONE 

3; «683 0149 1! 

: 86 0150 1 ! EQUATED SYMBOLS: 

; Bf 0151 1! 

; 3136 1! NONE 

; 0153 1! 

: 90 0154 1 ! OWN STORAGE: 

; i 0155 1! 

; 4 0156 1 

; 9 0157 1 GLOBAL ‘ 

3 Be B16 } FORSSL_XIT_LOCK : INITIAL (0); ! Clear if no handler Linked yet 

: 9% 0160 1! | 
c+ Sr 0161 1 ! EXTERNAL REFERENCES: | 
; Bide 1! 
: 0165 1 

; 100 0164 1 !+ 
: 101 0165 1 ! The following structure is used for addressing FORS$AA_LUB_TAB. 
: 102 0166 1! It is similar to VECTOR, but offsets the index so that 

s 70> 0167 1 ! negative logical unit numbers can be used. 

; 104 0168 1 !- 

; 105 0169 1 

: 106 0170 1 STRUCTURE 
: 107 0171 #1 FORSS$LUB 148.51 CI; N, LB, UNIT = 4, EXT = 0) = 

; 108 8176 1 CN*URIT | 
; 199 O1be ! (FORS$SLUB_TAB_ST + ((1 = LB)*UNIT))<O, ZSBPUNIT*UNIT, EXT>; 
ie bb 0175 1 EXTERNAL 
; 112 0176 1 FORSSAA_LUB_TAB : VOLATILE FORSSLUB_TAB_ST ! Table of LUB addresses 

3; (113 0177 1 E-L0BSK ILUN_MIN + LUBSK_LUN_MAR + T, LUBSK_ILUN_MINJ, 

: 18 78 ' FORSS$A_CUR_CUB; ! Cirren€ LUB 

3; «6116 0180 1 extesn®. ROUTINE 

mite 0181 1 FORSSCB_FETCH : NOVALUE, ' Load register CCB, no push 

: 118 1 3 1 FORSSCB_PUSH : JSB_CB_PUSH NOVALUE, ' Load register CCB 

3 «119 1 1 FORS$CB-POP : JSB_CB_POP NOVALUE, ' Done with register CCB 

: 130 184 1 FORSSGET_VM, ' Get virtual memory 

3: 121 185 1 FORSSNEXT_LUN : NOVALUE ' Get next LUN that might be open 

3 lee 0186 1 FORSSCLOSE_FILE : CALi_CCB, i Internal file closer 


8 
Baan ree ae ee NESE NOTRE UARUTLSHRNRReL GAB ah 


at H4 ] FORSS$SIGNAL: NOVALUE; ! Signal non-fatal error 


Geiaacd CoParmes S pe 7 aha 


FORSSEXIT_HANDL FORTRAN exit handler 16-Sep-1984 00:22: AX-11 Bliss-32 V4.0-74 P | 

1-013 14-$ eats yi 99:99:98 FORRTL.SRCJFOREXITHA.B52;1 _ (3) 
189 GLOBAL ROUTINE FORSSDECL_EXITH ' Declare VMS EXIT handler 
4 : NOVALUE = : 


7 
; 4% 
2 
Be 
.. 9 
ee 
3 
. 3 
. 2 
3 3 
3; 7% 
[2 
cise 
, 
= 
cea 
Rs 
> 2 
= 
; 3 
. 3 
F> 
5; 7 
3; 7 
; 7 
s 7} 
a 4 
; ¥ 
ee 
; 3 
ap 
$ 
3; 6 
3 1 
. oo 
:.% 
cc 
3 7% 
; 3 
os 
s 
: 3 
; Y 
3 7 
s 3 
. 2 
a 
3 6 
; fF 
3; 3 
s.¥ 
5 3 


'e4¢ 


| FUNCTIONAL DESCRIPTION: | 
Declares VMS EXIT handler for FORTRAN. 
i CALLING SEQUENCE: | 
! IF (NOT .FORSSL_XIT_LOCK) THEN FORSSDECL_EXITH () | 
i FORMAL PARAMETERS: | 
! NONE | 
i IMPLICIT INPUTS: | 
NONE | 
{ IMPLICIT OUTPUTS: | 
NONE 
i COMPLETION CODES: 
; NONE 
i SIDE EFFECTS: | 
& Declares VMS EXIT handler. 
| 
| 
| 


BEGIN 


14 
Allocate and fill in the control descriptor block. 


PXRAEXR_EDQ_EQQ_ DAA Se BBE EL ENN 


NOU SW OOS QSALAVZS Se NAWE WN OC OONAUE WN SO ODNAOUS WH ODO OAO 


LOCAL 
EXITH_CONTROL_BLOCK: REF VECTOR C, LONG]; 


PIPIPOPIPAIPIPIPNIPININININPYNPININPYPINNINPININPINONINPONINPONY 
SAW "WWI AIA AI PPIPUPIPOPIPUDINID) 2 9 SS 2 QO OOOOCOCOOOCOOCOWOOOOOOWOWO 


SODWNAWNE AN OOO NAUE WN $$ O OONA UE WIN (OO ODNAU SW OOONAUS WI 


Ne ee ee ee ee eee eee we wee lolol ele lo lol ola lo lololololololololololololololol oa) 
=PNIPINIPIPIPIPIAPINIAPINIPIPIPOPIPIDIAYD a nn nk nk nk tk tk at ot ot ot ot ot ot ot ot ot tt tt 


6 

6 

$ EXITH_CONTROL_BLOCK = FORSSGET_VM (20); ! 5 longwords 
EXITH_CONTROL_BLOCK C1) = EXIT_HANDLER; ' Routine address 

7 EXITH_CONTROL_BLOCK = 1; i | gees renal Longword 

7 EXITH CONTROL BLOCK = EXITH CONTROL BLOCK (4); ! Reason for exit 

7 SDCLERH (DESBCK=EXITH_CONTROL_BCOCK [OJ3; ! Assume success 

, FORSSL_XIT_LOCK = 1; ! Handler declared 

7 

7 


RETURN 
END; 


SE RIT HANOL FORTRAN exit handler 


FORSSEXIT_HANDL FORTRAN exit handler 1 
1-013 14- FORRTL.SRCJFOREXITHA.B 


«PSECT _FORSDATA,NOEXE, PIC,2 


8 | 
b-Se0-1984 90:99:06 AX-11 Bliss-32 Vi iha B$21 Page 6 


ONG O 3 | 
.EXTRN FORSSAA_LUB_T 
-EXTRN FORSSA_CUR_CUB, FORS$SCB_FETCH 
“EXTRN FORS$CB PUSH, FOR$$CB POP 
-EXTRN FORSSGET_VM, FORSSNEXT_LUN 
“EXTRN FORSSCLOSE FILE 
-EXTRN FORSSSIGNAL, SYSSDCLEXH 


-PSECT _FORSCODE,NOWRT, SHR, PIC,2 


0000 00000 ENTRY FORSSDECL_EXITH, Save nothing ; 0189 
14 DD 00002 PUSHL #20 3; 0232 

000000006 00 01 FB 44a CALLS #1, FORSSGET_VM : 
04 AO 0000v CF 43 00008 MOVAB EXIT_HANDLER, 4(EXITH_CONTROL_BLOCK) : 0233 
08 a0 01 00 00011 OVL #1, BCEXITH_CONTROL_BCOCK) 3 0234 
Oc aod 10 AO 9E 00015 MOVAB 16(RO), 12(EXITH_CONTROL_BLOCK) 3 0235 
50 DD OOO1A PUSHL €XITH_CONTROL BLOCK : 0236 

000000006 00 01 FB 0001C CALLS #1, SYSS$DCLEX 3 
00000000" EF 01 »d0 00023 MOVL #1, FORSSL_XIT_LOCK 3; 0237 
04 0002A RET ; 0240 


; Routine Size: 43 bytes, Routine Base: _FORSCODE + 0000 
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SSLESRALLESELSERFATSS 


VMFWN Oo 


PIPIPIPIPINIPYIPINININININOPIPONUNINUR) 2 2 te ec 
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Oe a ad a td tot IOOO 
ONAUSWN—O0MOnN 


; Routine Size: 


rc-——_——— --  -Ol- e 


Ooo 


Se ee ee we wea lola lolololololololololololololololelolo) 
SODWNAME WN $ O OONAU EWN OOO NAUE WR OOONOULS WH 


POPGPOPIPIPOPNINPONPYHNNPoNonofry 
ONIN NNN NNO 


14 bytes, 


ONIN te Fe ed ee ed ed eed 


exit handler 


ROUTINE EXIT HANDLER ( 
EXIT REASON 


1 
5) p= 


) : NOVACUE = 


le 


} FUNCTIONAL DESCRIPTION: 


This is the exit handler for FORTRAN. 
close all files. 


Upon entering, it clears FORSSL_XIT_LOCK. 
exit handlers to have their 1/0 cleaned up. 


i FORMAL PARAMETERS: 


EXIT_REASON.rl.r not used 


i IMPLICIT INPUTS: 


NONE 


| IMPLICIT OUTPUTS: 


FORSSL_XIT_LOCK is set to zero 


i ROUTINE VALUE: 
i COMPLETION CODES: 


NONE 


i SIDE EFFECTS: 


Closes all files by calling OTSS$CLOSE_ALL. 


BEGIN 
FORSSL_XIT_LOCK = 0; ! Clear exi 


FORSSCCOSE-ALL (); 


AX-11 Blisg-32 v4.0-742 
FORRTL.SRCIFOREXITHA.BS2; 1 


Its only function is to 


This allows user 


t handler interlock 


END; ! of routine EXIT_HANDLER 


0000 00000 EXIT_HANDLER: 
ORD 


oW Save ore 
00000000" EF 04 00002 CLRL FORSSL XIT_LOCK 
0000v CF 00 FB 00008 CALLS #0, FORSSCTOSE_ALL 
04 00000 RET 


Routine Base: _FORSCODE + 002B 


k 8 | 
FORSSEXIT_HANDL FORTRAN exit handler 16-Sep-1984 00:22: AX-11 Bliss-32 V4.0-74 Page 8 FOF 
1-01 . 197 808- 1 3be 90:44:98 AMANTL  SRESFORENI TNA. BS2:1 . ) 2-( 


ROUTINE FORSSCLOSE_ALL : NOVALUE = ' Close all files 
‘+ 


'e4 
FUNCTIONAL DESCRIPTION: 


table). For each LUB, if the file is open, purge its 1/0 
buffers and close it. If the file has been marked for PRINT 

or DELETE, this will cause proper disposition of the file. 

RMS will close all open files at image exit, but it doesn’t know 
about the above two DISPOSE conditions. We couldn't set them at 


Find ever reach ¢ LUB (with a linear search through the LUB 


OPEN time, since the user is allowed to specify a different 
DISPOSE option at close time (with the CLOSE statement). 


i FORMAL PARAMETERS: 

NONE | 
i IMPLICIT INPUTS: 

NONE 


NONE 


} 
| 
| 
i IMPLICIT OUTPUTS: | 
| 
i ROUTINE VALUE : 


i COMPLETION CODES: 
NONE 
i SIDE EFFECTS: 


S. 
CLOERR. 


Closes all : 


5 ile 
May signal FORS$ 


COOCCOCCOOCOCOCOOOCOC OOOO OOOCOOOOOOoOOOOO 


= K_CCB_REG : REF SFORSCCB_DECL; 


ae tee ee ee Ww 
WR 09 DOONAN $0 ODNOA NEW (OO OONOUE WN" OOONAUE WENO 


AOA VVIVIVIVI EE BBE EEE E PP 


| 

| 

GLOBAL REGISTER | 
ccB | 

| 
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; BEGIN 
: 


0 
$3 LOCAL 
83 AST_STATUS, ! Status from S$SETAST 
64 FLAG, 
65 8 e | 
66 3 
67 032 + 
68 83 ! Disable ASTs. 
69 3 32 
70 03 
73 03 AST_STATUS = $SETAST (ENBFLG=0); 
7 ? 
74 o334 ' Scan through the table of LUNs, looking for allocated CCBs. 
ipa 3B ioe 
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AANA RINUPRINIPIPINONIDY 4 oe oe 
WN —OOONO UF WIN OC CONOUSWN—O 


DIAAA NAIA AANA AA AAA NAW 


WW 


SOOSOOCOOSOOSCOCSQVOOOSOOSOSOOCOSCOSOSOSOSOSOOSSOCOCOSCCOOCOOCOOCOOOOOOOOOOOOOCOCO 


WANA AAAI AAAI WIAA AAAI AAA AANA AAW AIA ANNA AAWI 
PWN 0 OONOA UES WN (OOD NOU EWN 9 ODNAU EWN 0 ODNOU EWN SCO CONOUS WOO 


OOOO O09 09 0909 09 09 00 0909 00 SI NIN NINN NN NN SRA AA AAA AAA MMIII BP EPP EE 


PIMP PONEPOPININIW WINNIE BS UIT & AAAI 


FORR 
FLAG = 0; ! Initialize loop 


WHILE 1 DO 
BEGIN 


4 
Set next unit number that has an allocated CCB. 


FORSSNEXT_LUN (FLAG, LUN); 
IF NOT .FCAG 


THE 
EXITLOOP; 


4 
Get the CCB address for this unit. 


CCB = 0; ! Make BLISS understand that CCB is set. 
FORS$CB.FETCH (.LUN); 
FORSSA_CUR_LUB = .CCB; ! Make this LUB the current one 


1+ 

! We have an allocated CCB. See if it has an open file. If 
! so, try to close it. If the close fails, signal ‘'close error’’, 
but with E severity so that execution continues. 


IF .€CB CLUBSV_OPENED) 
THEN 


BEGIN 
IF NOT FORSSCLOSE_FILE () 
THEN 
BEGIN 
LO 


CAL 
CLO_ERROR: BLOCK (4, BYTE]; ! Condition to signal 

CLO_ERROR = FORS_CLOERR; 

CLO-ERROR CSTS$V-SEVERITY] = STSSK_ERROR; 

FORSSSIGNAL (.CLO_ERROR); 


E 
END; 
'¢ 


i Zero the CCB address in the table of CCBs/LUBs. This prevents 
anything else from happening to this incarnation of the file. 


FORSSAA_LUB_TAB [.LUN] = 0; 
END; 


+ 
If ASTs were previously enabled, re-enable them. 


IF .AST_STATUS EQL SS$_WASSET 
SSETAST (ENBFLG=1); 


andl tata FORTRAN exit handler 


Se Ge Be Ge Se 


i 


50 


> Routine Size: 


Name 
_FORSDATA 


a336 Rerum: 


000000006 


000000006 
000000006 


000000006 


03 
900000006 


115 bytes, Routine 
0398 1 END 

0399 

0400 0 ELUDOM 


Bytes 


080C 00000 FORSSCLOSE ~‘ 


M 
16S 
14 


8 
ep-1984 
- gep-19 


Be 92:84:58 


AX-11 


! of routine FORSSCLOSE_ALL 


~EXTRN 


SYSSSETAST 


oar eee (2mm 


FORSS¢B_ FETCH 
af FORSS$A~CUR_LUB 


(€cB) 
10, FORSSCLOSE_FILE 


R 
#160 860, 3c ERROR 
#2 1 aL, CCO_ERROR 


L 
CLO_ERMoR 

LUN, RO 
FORSSAA_LUB_TAB+32(RO) 
AST_STATUS, #9 

4$ 


#1 
#1, SYSSSETAST 


End of FORSSEXIT_HANDL module 


WO 
53 000000006 00 4 00002 MOV 
SE 98 C BR ORE SUBL 
—E 04 0000C CLRL 
63 1 FB QOOOE CALLS 
52 0 pO 00011 OVL 
04 AE D4 00014 CLRL 
5E DD 00017 1$: PUSHL 
08 AE 9F 00019 PUSHAB 
00 02 FB Bn0as CALLS 
41 04 AE €9 0002 BLBC 
5B 04 00027 CLRL 
6E DD 00029 PUSHL 
00 01 FB 000 8 CALLS 
00 5B dO 000 MOVL 
1F FC AB €E9 00039 BLBC 
00 00 Fe 00030 CALLS 
15 50 €E8 00044 BLBS 
50 001880E4 8F D0 00047 MOVL 
00 02 FO eid INSV 
50 DD 0005 PUSHL 
00 01 FB 00055 CALLS 
50 oF DO O005C 2$: MOVL 
0000000060040 D4 0005F CLRL 
AF 11 00066 BRB 
09 52 Di 00068 3$: CMPL 
05 12 00068 BNEQ 
01 DD 0006D PUSHL 
63 01 FB OO06F CALLS 
04 00072 4$: RET 
Base: _FORSCODE + 0039 
' 
PSECT SUMMARY 
Attributes 
4 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, 


REL, 


CON, 


Bliss-32 V4.0 
AOARTL” SRC FOREXITHA, 


PIC,ALIGN(2) 


7382; 1 


ooo COCO OOO 


o 
WN 
co 


3; Elapsed Time: OP: g1-9 
3; Lines/CPU Min: 34 ; 

3; Lexemes/CPU-Min: 972 

: penety Used: 90 pages 

; a 


; Compilation Complete 


nN 8 

FORSSEXIT_HANDL FORTRAN exit handler 165 ep-1984 AX-11 Bliss-32 V4.0-7 Page 11) 

1-013 14- 305-1984 99: $4: 9§ FORRTL.SRC FOREXITHA.B 2:1 . (5) | 

>  FORSCODE 172 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) | 
| 

: Library Statistics 

pe ee ei ees = Syabels seeccess Pages Processing 

; File Total Loaded Percent Mapped Time 

: ~BE2280UAE: SYSLIBISTARLET.L32;1 9776 7 9 581 00:01.0 | 

: Ritts 8: CFORRTL.OBJ ont 18 gg: 711 184 2 5 180-9 

: _$255$DUA28:CFORRTL.OBJIRTLLIB.L32;1 36 0 00:00.1 | 
} 

; COMMAND QUALIFIERS 

NT Se NET PT INSEE PELOML EPL SOME. SER EP ORE RE EDIE yer ane ns to MSRC$:FOREXI THA/UPDATE=(ENHS$:FOREXITHA 

; Size: 172 code + 4 data bytes 

; Run Time: 00:06.9 
| 
| 


L EQUIPMENT CORPORATION 
ENTIAL .AND PROPRIETARY 


AH-BT13A-SE 
VAX/VMS V4.0 


G 
N 


TA 
ID 


0180 F 


DI 
CO 


